## Author:	lukas.stoetzer@uzh.ch
## Project: Forecasting Coalition Options
## Content:
##    * Prepare Data for German Federal Elections
##    * Estimate Models filtered & coal option save output

# Load libraries
  library(tidyverse)
  library(zoo)
  library(reshape2)
  
# Source Functions
  source("fun_dmd.R")

# Load Poll Data-base
  polls_df <- read_csv("Polls_btw.csv")

# Parties to consider for a given election
  sel_party <- c("cdu","spd","fdp","lin","gru","oth")

  for(e in c(1994,1998,2002,2005,2009,2013,2017)) {

  # For 2017 add AFD
    if(e==2017) sel_party <- c("cdu","spd","fdp","lin","gru","afd","oth")
    
  # Create Polls Data-frame for this election with weekly vote intetnion counts for each party 
    polls_elc <- polls_df %>% 
      filter(election==e) %>% # Select Election
      spread(party, support) %>% # Spread to wide format
      mutate_at(vars(sel_party),funs(count = round(./100 * sample_size) ))  %>% # Calc number of respondents
      mutate(weeks_to_election = round(difftime(election_date,date, units="weeks")) +1 ) %>% # weeks to election
      select(weeks_to_election, paste(sel_party,"_count",sep="")) %>% # Select Columns
      group_by(weeks_to_election) %>% # Group by election days to aggreagte
      na.omit() %>% # omit missing values
      summarise_all(funs(s = sum(.))) %>%
      arrange(desc(weeks_to_election))  # Order strating with polls furthest away from election
    
   colnames(polls_elc)[-1] <- sel_party
    
  # Create Matrix with vote intentions
    VI <- left_join(data_frame("weeks_to_election"=max(polls_elc$weeks_to_election):min(polls_elc$weeks_to_election)),
                    mutate(polls_elc, weeks_to_election = as.numeric(weeks_to_election))) %>% # expand grid
      select(cdu:oth) %>% as.matrix()
  
  # Creeate Vector with SampleSize
    N <- apply(VI,1,sum)
    
  ## Estimate discount Factor
    prior <- VI[nrow(VI),]/100
    res <- est_d(y = VI, n = apply(VI,1,sum), a0 = prior)
    d <- res$par
    d.se <- sqrt(diag(solve(-res$hessian)))
    
    alpha <- update_alpha(VI, d=d, palpha = prior)
    pi_est <- get_ci_pi(alpha,ci = c(0.05,0.95), pty_nam = sel_party,Nrep = 1000)
  
  ## Plot Levels
    df_poll <- melt(VI/apply(VI,1,sum))
    names(df_poll) <- c("time","pty_nam","value")
    
    clrs <- c("#000000","#F0001C", "#FFED00", "#AA0000", "#58AB27","#B3B3B3")
    if(e == 2017 ) clrs <- c("#000000","#F0001C", "#FFED00", "#AA0000", "#58AB27","royalblue","#B3B3B3")
    
    b <- 4*52 + c(-12*4,-6*4,-4*3,-4,-1)
    b_lab <- c("1 Year", "6 Month", "3 Month", "1 Month", "1 Week")
    
  ## Coalition Majority Functions
    coal <- list(
      "cdu-spd"=c(1,2),
      "cdu-fdp"=c(1,3),
      "cdu-gru"=c(1,5),
      "cdu-fdp-gru"=c(1,3,5),
      "spd-gru"=c(2,5),
      "spd-gru-lin"=c(2,5,4),
      "spd-gru-fdp"=c(2,5,3))
    
    # Sample Probability
    res_caol <- t(apply(alpha[,-ncol(alpha)],1,get_coalop, cbn = coal, Nrep=1000))
    
    # Prepare Data
    df <- melt(res_caol)
    names(df) <- c("day","coalition","prob")
    df$coalition <- as.factor(df$coalition)
    levels(df$coalition) <- c("cdu-spd","cdu-fdp","cdu-gru","cdu-fdp-gru","spd-gru","spd-gru-lin","spd-gru-fdp")
    
  # Save Results for Election
    lres <- list(d,alpha,pi_est,res_caol,VI,N,polls_elc,d.se)
    saveRDS(lres,file=paste("ddm_res_",e,".RDS",sep=""))
    
  }
  